home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / fftpack / cfftb1.f < prev    next >
Text File  |  1995-12-14  |  2KB  |  63 lines
  1.       subroutine cfftb1 (n,c,ch,wa,ifac)
  2.       implicit double precision (a-h,o-z)
  3.       dimension       ch(*)      ,c(*)       ,wa(*)      ,ifac(*)
  4.       nf = ifac(2)
  5.       na = 0
  6.       l1 = 1
  7.       iw = 1
  8.       do 116 k1=1,nf
  9.          ip = ifac(k1+2)
  10.          l2 = ip*l1
  11.          ido = n/l2
  12.          idot = ido+ido
  13.          idl1 = idot*l1
  14.          if (ip .ne. 4) go to 103
  15.          ix2 = iw+idot
  16.          ix3 = ix2+idot
  17.          if (na .ne. 0) go to 101
  18.          call passb4 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3))
  19.          go to 102
  20.   101    call passb4 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3))
  21.   102    na = 1-na
  22.          go to 115
  23.   103    if (ip .ne. 2) go to 106
  24.          if (na .ne. 0) go to 104
  25.          call passb2 (idot,l1,c,ch,wa(iw))
  26.          go to 105
  27.   104    call passb2 (idot,l1,ch,c,wa(iw))
  28.   105    na = 1-na
  29.          go to 115
  30.   106    if (ip .ne. 3) go to 109
  31.          ix2 = iw+idot
  32.          if (na .ne. 0) go to 107
  33.          call passb3 (idot,l1,c,ch,wa(iw),wa(ix2))
  34.          go to 108
  35.   107    call passb3 (idot,l1,ch,c,wa(iw),wa(ix2))
  36.   108    na = 1-na
  37.          go to 115
  38.   109    if (ip .ne. 5) go to 112
  39.          ix2 = iw+idot
  40.          ix3 = ix2+idot
  41.          ix4 = ix3+idot
  42.          if (na .ne. 0) go to 110
  43.          call passb5 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  44.          go to 111
  45.   110    call passb5 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  46.   111    na = 1-na
  47.          go to 115
  48.   112    if (na .ne. 0) go to 113
  49.          call passb (nac,idot,ip,l1,idl1,c,c,c,ch,ch,wa(iw))
  50.          go to 114
  51.   113    call passb (nac,idot,ip,l1,idl1,ch,ch,ch,c,c,wa(iw))
  52.   114    if (nac .ne. 0) na = 1-na
  53.   115    l1 = l2
  54.          iw = iw+(ip-1)*idot
  55.   116 continue
  56.       if (na .eq. 0) return
  57.       n2 = n+n
  58.       do 117 i=1,n2
  59.          c(i) = ch(i)
  60.   117 continue
  61.       return
  62.       end
  63.